00100	C  ********** PROCESSES INPUT FOR MS PROGRAM.  PUTS OUT .MS FILES.
00300	C*** CALLS FOLLOWING SUBROUTINES: READX,SCMSS,HOMX,NAMEXT
00400	
00500		IMPLICIT INTEGER(A-Q,S-Z)
00600		REAL DIS,STFF,CENTR,POS
00700		COMMON /DL/X22,SAVER,NAME,EXT,IOLD
00800		1/RINP/R(10,80),RPOS(2,50),RI(200)  /RMOD/RMODE2,RSET4,IBEAM,
00910		3 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
00920		COMMON/SCX/ICOM,MINUS,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR,ICOLON,
00940		1 ISEMI,IDBQT,IBLA,IDOL,IPRCNT,IANPR,IAT,INUM,LESS,IGT,IAPOS,
00960		1 IQUES,IEXCLA,LBRK,RBRK,UPAR,DNAR,DBLAR,SLA,XX,ZZ,
00980		1 J4,LL,Y,K,RX,RZ,RA,J5 
01100	C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
01200		COMMON  /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
01300		1 /STF/RSTFAC(0/7),RSTJ2
01400		2  /POSI/STFF(0/7),JJ2,POS  /ALF/INP(72),ML 
01500		3 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01600		4 /IDEV/IDEV,CHNG 
01700		5 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(350)
01800	CC	2 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM 
01900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW 
02000		1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO 
02200		EQUIVALENCE (R5,RJQ(3)),(I4,INP(4)),(R6,RJQ(4)),(R4,RJQ(2)),
02400		2(R7,RJQ(5)),(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),
02500		4 (R8,RJQ(6)),(IPOS,POS)
02700		DATA RNW/2.44/,LCNT/1/,LIMIT/3000/,DIS/1.0/, RHT/1.0/
02800		5 ,EXT/'MS '/
02810	CC	5 ,PLUS/'+'/,EXT/'MS '/,COMMA/','/,ISEMI/';'/,IBLA/' '/
03200	C LIMIT IS MAIN ARRAY LENGTH (3000)
03300	C  350 LIM. ON ITEMS PWDS.
03400	
03500		IDEV=1
03600		I1=0
03700		IX=0
03800		RSET4=999
03900		RPOS(1,1)=0
04000		PWDS(1)=1
04200	C  FOR RESTART.  AVOIDS STAFF CODE NUM.
04300		DO 30 K=0,7
04400	30	RSTFAC(K)=1.
04500		M=1
04600		ITEM=0
04700		I=1
04800	40	SCORE=-1
04900	
05000		TYPE 100 
05100	100	FORMAT(' TYPE FILE NAME (OR X=DONE)  '$)
05200	101	FORMAT(2A5)
05300		ACCEPT 101,NAME
05400		IF(NAME.EQ.IBLA)NAME='INPUT'
05500		IF(NAME.EQ.'X')GO TO 1100
05600		CALL IFILE(1,NAME)
05700		
05800	130	READ(IDEV,700,END=40)INP
05900	C WILL NOT READ 'E' DIRECTORY PAGES!
06000		IF(I1.EQ.IBLA)GO TO 130
06100	320	CALL READX
06200		IF(I1.LT.0)GO TO 950
06300	C DO NEXT IF 1ST CHAR. WAS NUMBER.
06400		M=I
06500		RN(I+1)=JA
06600		RN(I+2)=R2
06700		K=10
06800		J=0
06900	400	IF(RJQ(K).EQ.0)GO TO 420
07000		IF(J.EQ.0)J=K
07100	C SAVE POINTER TO LAST NUM. IN LIST
07200	420	RN(I+K+2)=RJQ(K)
07300		K=K-1
07400		IF(K.GT.0)GO TO 400
07500		RN(I)=J
07600		I=I+J+3
07700		GO TO 1020 
07800	
07900	700	FORMAT(72A1)
08000	950	JA=140
08100		RMODE2=R3
08300	960	SCORE=0
08400		IF(JA.NE.140)GO TO 990
08500	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
08600		RSTF=R2
08700		DO 970 K=1,ITEM
08800		J=PWDS(K)
08900		IF(RN(J+1).NE.8.)GO TO 970
09000	 	IF(RN(J+2).NE.R2)GO TO 970
09100		ITEM=ITEM-1
09200		GO TO 980
09300	970	CONTINUE
09400	C DIDN'T FIND THIS STAFF
09500	C	ITEM=ITEM+1
09600		RSTF=R2
09700		RN(I)=6.
09800		RN(I+1)=8.
09900		RN(I+2)=R2
10000		IF(R3.LT.0)R3=0
10100		RN(I+3)=R3
10200		RN(I+4)=R4
10300		RN(I+5)=R5
10400		RN(I+6)=R6
10500		RN(I+7)=R7
10600		RN(I+8)=R8
10700		IF(R5.EQ.0)R5=1.
10800		RSTFAC(IFIX(R2))=R5
10900	C P4 ???
11000		I=I+9
11100	980	JA=140
11200		ICHK=I
11300	990	M=I
11400		REND=0
11500	C REND=0 GO,  -1=NORMAL END,  1=ABORTED.
11600		CALL SCMSS
11700		IOLD=0
11800	1020	J=M
11900	1030	ITEM=ITEM+1
12000		PWDS(ITEM)=J
12100		J=J+RN(J)+3
12200		IF(J.LE.I)GO TO 1030
12300		ITEM=ITEM-1
12400		IF(IBEAM.LT.0)GO TO 130
12500		R2=RSTF
12600		JA=-1
12700		CALL HOMX
12800	C GO ADJUST STEM LENGTHS
12850		CALL SHRINK(JIT)
12875	C GETS RID OF UNNEEDED ZEROS IN PARAM LIST.
12900		GO TO 130
13000	1100	CALL TYPSTR('NAME.EXT? ')
13100		ACCEPT 700,INP
13200		CALL NAMEXT(INP,NAME,EXT)
13300		IF(NAME.EQ.IBLA)NAME='TMP'
13400		IF(EXT.EQ.IBLA)EXT='MS'
13500	41	CALL PUTEXT(NAME,EXT)
13600		JJ2=ITEM+2
13700		IPOS=I
13800		CALL EXTOUT(RSTFAC,128)
13900		CALL EXTOUT(RN,I)
14000		CALL FINEXT
14100		END
14600		SUBROUTINE PNUM
14700		END
14800		SUBROUTINE PRESCN
14900		END
16600		SUBROUTINE LO2UP
16700		END
16800	
16900		SUBROUTINE NAMEXT(I,NAME,IEXT)
17000	C FINDS NAME.EXT IN A1 STRING
17100		DIMENSION I(1)
17120		COMMON/SCX/ICOM,MINUS,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR,ICOLON,
17140		1 ISEMI,IDBQT,IBLA
17200	
17300		IF(I(1).NE.-1)GO TO 9
17400	C FIRST PASS UP 'G', 'GM', 'RS', ETC.  (=-1)
17500		DO 1 K=1,72
17600	1	IF(I(K).EQ.IBLA)GO TO 2
17700	C NOW PASS BLANKS
17800	2	J=72
17900		DO 3 J=K+1,72
18000	3	IF(I(J).NE.IBLA)GO TO 4
18100	C NOW FOUND START OF WORD (UNLESS ALL BLANKS)
18200	4	IF(J.NE.72)GO TO 5
18300		NAME=IBLA
18400		RETURN
18500	9	J=1
18600	5	DO 6 K=J,72
18700		IF(I(K).EQ.IBLA)GO TO 7
18800	C JUMP IF NAME ONLY
18900	6	IF(I(K).EQ.IDOT)GO TO 8
19000	7	CALL PACKX(NAME,I(J))
19100		RETURN
19200	8	CALL RLOOP(I(61),I(J),K-J)
19300		CALL PACKX(NAME,I(61))
19400		CALL PACKX(IEXT,I(K+1))
19500		END
19600	
19700		SUBROUTINE PACKX(NAM,KNM)
19800		DIMENSION KNM(5)
19900		DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
20000		1 , MM/"774000000000/
20100		NAM=0
20200		DO 12 K=5,1,-1
20300		NAM=NAM .OR. (KNM(K) .AND. MM)
20400		IF (K.EQ.1)RETURN
20500	17	IF (NAM.GE.0)GO TO 13
20600		NAM = (( NAM .AND. LL)/KK) .OR. JJ
20700		GO TO 12
20800	13	NAM = NAM / KK
20900	12	CONTINUE
21000		RETURN
21100		END
21200	
21300		BLOCK DATA
21400	C **** WHEN JALPHA IS EXTENDED FIX LOOP AT 365 AND SUBR. NEWR(IN LOOP)
21500	C **** AND SUBR. SCMSS, NOTBMS, RHYTH AND BEAMS
21600		COMMON/SCX/JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5 
22000		COMMON/SCN/KEL,KR,KU,KD,KSLA,NONO(30)
22100		1 /NUM/NUM(10),JRD/MKS/MKS(14)
22200		COMMON/A2Z/IAZ(26)
22400		2  /POSI/STFF(0/7),JJ2,POS  /STF/RSTFAC(0/7),RSTJ2
22700		COMMON/FRMT/F78F(1),FONE(1),FA5(1),ASK
22720		2 /MKX/MKX(11) /SC/SSC(72)
22736		DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
22752		1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
22755	C THE GIANT NUMBERS ARE FOR [ AND ]
22768	C LIMIT IS MAIN ARRAY LENGTH (3000)   /SC/SSC ARRAY USED IN MARKS,BEAMS,SLURS
22784	C  350 LIM. ON ITEMS PWDS.
22800		DATA F78F/'(78F)'/,FONE/'(A1 )'/,FA5/'(A5 )'/
22900		DATA LEL/'L'/,LR/'R'/,LU/'U'/,LD/'D'/,LE/'E'/
23000		1,LC/'C'/,LS/'S'/,LF/'F'/,LA/'A'/,LI/'I'/,LW/'W'/,XFONT/50./
23100		DATA IAZ/'A','B','C','D','E','F','G','H','I','J','K','L','M',
23200		1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/
23300	C	1 ,IBKSL/"561004020100/
23400	C  IBKSL=\   BACKSLASH - NOT USED YET  5/80
23500		DATA JALPHA/',','-','.','=','(',')','+','*',':',';'
23600		1 ,'"',' ','$','%','&','@','#','<','>',1H','?','!'
23700		1 ,"555004020100,"565004020100,"571004020100,"5004020100,
23800		1 "135004020100,'/',"755004020100,"771004020100/
23900		1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
24000		DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
24100		DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/
24200		END